PC Users 1999 April/Cd Pc Users extra 19 abril 1999.iso/Prog/Inst/addin/Propset.cls

Text File | 1997-05-20 | 5.2 KB | 176 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "PropSet"
Attribute VB_Creatable = True
Attribute VB_Exposed = True
Attribute VB_Description = "Property Setter"
' ************************************************
' This class implements the Set Properties add-in.
'
' If includes the ConnectAddIn and DisconnectAddIn
' subroutines in addition to the property setting
' event handler code.
' ************************************************
Option Explicit

' The environment instance.
Dim VBInstance As VBIDE.Application

' The command line.
Dim SetPropLine As VBIDE.MenuLine

' The event connection ID. Represents the
' event handler to menu line connection.
Dim SetPropID As Long

' ************************************************
' Connect the add-in to the Visual basic
' environment. This happens when the user invokes
' the Add-in Manager to put the add-in in the
' Add-Ins menu.
' ************************************************
Sub ConnectAddIn(vb_instance As VBIDE.Application)
    ' Save the Visual Basic instance for later.
    Set VBInstance = vb_instance

    ' Add the command.
    Set SetPropLine = VBInstance.AddInMenu.MenuItems.Add("&Set Properties...")

    ' Connect the event handler object to the
    ' menu line.
    SetPropID = SetPropLine.ConnectEvents(Me)
End Sub
' ************************************************
' Set the properties for the selected controls.
' ************************************************
Public Sub AfterClick()

    ' Present the dialog.
    Set SetterDialog.prop_setter = Me
    SetterDialog.Show vbModal
    Unload SetterDialog
End Sub
' ************************************************
' Disconnect the add-in from the Visual basic
' environment. This happens when the user invokes
' the Add-in Manager to put the add-in in the
' Add-Ins menu.
' ************************************************
Sub DisconnectAddIn(mode As Integer)
    ' Disconnect the event handlers.
    SetPropLine.DisconnectEvents SetPropID

    ' Remove the command.
    VBInstance.AddInMenu.MenuItems.Remove SetPropLine
End Sub




' ************************************************
' Return a list of the selected controls and their
' property values.
' ************************************************
Public Function GetValues(prop_name As String) As String
Dim ctl As Object
Dim controls As VBIDE.SelectedControlTemplates
Dim txt As String
Dim value As String
Dim field_name As String
Dim idx As String

    GetValues = ""
    If NoControls() Then Exit Function

    Set controls = VBInstance.ActiveProject. _
        ActiveForm.SelectedControlTemplates

    txt = ""
    For Each ctl In controls
        field_name = ctl.Properties("Name")
        idx = ctl.Properties("Index")
        If idx <> "-1" Then _
            field_name = field_name & _
            "(" & idx & ")"
        txt = txt & field_name & _
            Space$(20 - Len(field_name))

        On Error Resume Next
        value = ctl.Properties(prop_name)
        If Err.Number = 438 Then
            ' Property not supported.
            value = ""
        ElseIf Err.Number <> 0 Then
            Beep
            MsgBox "Error reading property." & _
                Error.Description, _
                vbOKOnly + vbInformation, _
                "Property Error"
            Exit Function
        End If
        On Error GoTo 0

        txt = txt & value & vbCrLf
    Next ctl
    GetValues = txt
End Function
' ************************************************
' Set the indicated property value. Return an
' updated list of the selected controls and their
' property values.
' ************************************************
Public Function SetValues(prop_name As String, prop_value As String) As String
Dim ctl As Object
Dim controls As VBIDE.SelectedControlTemplates
Dim txt As String
Dim field_name As String
Dim idx As String

    SetValues = ""
    If NoControls() Then Exit Function

    Set controls = VBInstance.ActiveProject. _
        ActiveForm.SelectedControlTemplates

    For Each ctl In controls
        On Error Resume Next
        ctl.Properties(prop_name) = prop_value
        If Err.Number <> 0 And Err.Number <> 438 Then
            Beep
            MsgBox "Error setting property." & _
                Error.Description, _
                vbOKOnly + vbInformation, _
                "Property Error"
            Exit Function
        End If
        On Error GoTo 0
    Next ctl
    SetValues = GetValues(prop_name)
End Function


' ************************************************
' Return true if there are no controls selected.
' ************************************************
Function NoControls() As Boolean
    NoControls = True

    ' Sneak up on the collection of selected
    ' controls so we don't try to access an
    ' object that is Nothing.
    If VBInstance.ActiveProject Is Nothing Then _
        Exit Function
    If VBInstance.ActiveProject.ActiveForm _
        Is Nothing Then _
        Exit Function
    If VBInstance.ActiveProject.ActiveForm. _
        SelectedControlTemplates.Count < 1 Then _
        Exit Function

    NoControls = False
End Function